Analisi cluster demografici con algoritmo non supervisionato (k-mean)

RQ: A partire dalla stratificazione del dataset per categorie demografiche, è possibile individuare cluster in relazione ai fenomeni osservati?

Filtro topic: Diabetes & Cardiovascular Disease

library(dplyr)

dataset_path <- "u_s_chronic_disease_indicators_cdi.csv"

df <- read.csv(dataset_path, na.strings = c("", "NA", "NULL", "null"))

df_filtered <- df %>%
  filter(topic %in% c("Diabetes", "Cardiovascular Disease"))

Conteggio categorie demografiche univoche

df_filtered %>%
  filter(stratificationcategory1 == "Race/Ethnicity") %>%
  count(stratification1) %>%
  arrange(desc(n))
NA

Visualizzazione question univoche

library(dplyr)

qid_map <- df_filtered %>%
  distinct(questionid, question) %>%
  arrange(questionid)

# Mostra la tabella
knitr::kable(qid_map, col.names = c("QuestionID", "Question"))
QuestionID Question
CVD10_1 Pneumococcal vaccination among noninstitutionalized adults aged 18-64 years with a history of coronary heart disease
CVD10_2 Pneumococcal vaccination among noninstitutionalized adults aged >= 65 years with a history of coronary heart disease
CVD1_1 Mortality from total cardiovascular disease
CVD1_2 Mortality from diseases of the heart
CVD1_3 Mortality from coronary heart disease
CVD1_4 Mortality from heart failure
CVD1_5 Mortality from cerebrovascular disease (stroke)
CVD2_0 Hospitalization for heart failure among Medicare-eligible persons aged >= 65 years
CVD3_1 Hospitalization for stroke
CVD3_2 Hospitalization for acute myocardial infarction
CVD4_0 Cholesterol screening among adults aged >= 18 years
CVD5_0 High cholesterol prevalence among adults aged >= 18 years
CVD6_1 Awareness of high blood pressure among adults aged >= 18 years
CVD6_2 Awareness of high blood pressure among women aged 18-44 years
CVD7_0 Taking medicine for high blood pressure control among adults aged >= 18 years with high blood pressure
CVD8_0 Pre-pregnancy hypertension
CVD9_1 Influenza vaccination among noninstitutionalized adults aged 18-64 years with a history of coronary heart disease or stroke
CVD9_2 Influenza vaccination among noninstitutionalized adults aged >= 65 years with a history of coronary heart disease or stroke
DIA10_0 Adults with diagnosed diabetes aged >= 18 years who have taken a diabetes self-management course
DIA11_1 Prevalence of high cholesterol among adults aged >= 18 years with diagnosed diabetes
DIA11_2 Prevalence of high blood pressure among adults aged >= 18 years with diagnosed diabetes
DIA11_3 Prevalence of depressive disorders among adults aged >= 18 years with diagnosed diabetes
DIA12_1 Influenza vaccination among noninstitutionalized adults aged 18-64 years with diagnosed diabetes
DIA12_2 Influenza vaccination among noninstitutionalized adults aged >= 65 years with diagnosed diabetes
DIA13_1 Pneumococcal vaccination among noninstitutionalized adults aged 18-64 years with diagnosed diabetes
DIA13_2 Pneumococcal vaccination among noninstitutionalized adults aged >= 65 years with diagnosed diabetes
DIA1_1 Mortality due to diabetes reported as any listed cause of death
DIA1_2 Mortality with diabetic ketoacidosis reported as any listed cause of death
DIA2_1 Prevalence of diagnosed diabetes among adults aged >= 18 years
DIA2_2 Diabetes prevalence among women aged 18-44 years
DIA3_1 Prevalence of pre-pregnancy diabetes
DIA3_2 Prevalence of gestational diabetes
DIA4_0 Amputation of a lower extremity attributable to diabetes
DIA5_0 Foot examination among adults aged >= 18 years with diagnosed diabetes
DIA6_0 Glycosylated hemoglobin measurement among adults aged >= 18 years with diagnosed diabetes
DIA7_0 Dilated eye examination among adults aged >= 18 years with diagnosed diabetes
DIA8_0 Visits to dentist or dental clinic among adults aged >= 18 years with diagnosed diabetes
DIA9_0 Hospitalization with diabetes as a listed diagnosis
NA

Preparazione datavalue per K-Means

library(dplyr)

# conversione in numerico di datavalue (da eventuale stringa) e gestione virgole (da , a .)
df_k <- df_filtered %>%
  mutate(
    datavalue_num = suppressWarnings(as.numeric(gsub(",", ".", datavalue, fixed = TRUE))),
    .row = dplyr::row_number()
  )

K-Means (k = 7) per ciascuna combinazione (topic, questionid, datavaluetypeid)

library(dplyr)
library(purrr)

set.seed(9)

# esegue il clustering per ogni combinazione di topic, questionid e datavaluetypeid
clustered <- df_k %>%
  # raggruppa i dati
  group_by(topic, questionid, datavaluetypeid) %>%
  # applica una funzione personalizzata a ciascun gruppo
  group_modify(~{
    # prende il sottoinsieme di dati relativo al gruppo
    d <- .x
    # rimuove le righe con valori mancanti in datavalue_num
    d_non_na <- d %>% filter(!is.na(datavalue_num))

    # se il gruppo ha meno di 7 righe non può essere diviso in 7 cluster
    if (nrow(d_non_na) < 7) {
      # assegna valori mancanti alla colonna cluster
      d$cluster <- NA_integer_
      # restituisce il gruppo così com’è
      d
    } else {
      # esegue kmeans con 7 cluster e 25 inizializzazioni
      km <- kmeans(d_non_na$datavalue_num, centers = 7, nstart = 25)
      # assegna l’etichetta di cluster ai dati senza valori mancanti
      d_non_na$cluster <- km$cluster

      # unisce i cluster calcolati ai dati originali usando l’indice di riga
      d %>% left_join(d_non_na %>% select(.row, cluster), by = ".row")
    }
  }) %>%
  # rimuove la struttura di raggruppamento dal risultato finale
  ungroup()

# anteprima dei risultati con le colonne principali
clustered %>%
  select(topic, questionid, datavaluetypeid, datavalue_num, cluster) %>%
  head()
NA

Percentuali per stratification (solo Race/Ethnicity) dentro ciascun cluster

library(dplyr)
library(tidyr)

# calcolo delle percentuali per ogni cluster e stratification
cluster_strat_pct <- clustered %>%
  # filtra solo i record con categoria race/ethnicity ed esclude cluster mancanti
  filter(stratificationcategory1 == "Race/Ethnicity", !is.na(cluster)) %>%
  # raggruppa per topic, questionid, datavaluetypeid e cluster
  group_by(topic, questionid, datavaluetypeid, cluster) %>%
  # calcola la dimensione totale del cluster
  mutate(cluster_total = n()) %>%
  # raggruppa ulteriormente per stratification1
  group_by(topic, questionid, datavaluetypeid, cluster, stratification1) %>%
  # calcola il numero di elementi per ogni combinazione
  summarise(
    n = n(),
    cluster_total = dplyr::first(cluster_total),
    .groups = "drop_last"
  ) %>%
  # calcola la percentuale di ciascuna categoria sul totale del cluster
  mutate(pct = 100 * n / cluster_total) %>%
  # rimuove i raggruppamenti
  ungroup() %>%
  # ordina i risultati
  arrange(topic, questionid, datavaluetypeid, cluster, desc(pct))

# anteprima delle prime 20 righe della tabella finale
cluster_strat_pct %>% head(20)
NA

Grafico d’esempio sulla combinazione più rappresentata

library(dplyr)
library(tidyr)
library(ggplot2)

# definisce una funzione che genera 7 grafici a torta per una combinazione di topic, questionid e datavaluetypeid
plot_pies_for_combo <- function(topic_sel, questionid_sel, datavaluetypeid_sel) {
  # filtra i dati per la combinazione scelta e completa i cluster mancanti
  df_plot <- cluster_strat_pct %>%
    filter(
      topic == topic_sel,
      questionid == questionid_sel,
      datavaluetypeid == datavaluetypeid_sel
    ) %>%
    complete(
      cluster = 1:7,
      stratification1,
      fill = list(n = 0, cluster_total = 0, pct = 0)
    ) %>%
    mutate(label = ifelse(pct > 0, paste0(round(pct, 1), "%"), NA))

  # calcola i centroidi dei cluster per la combinazione scelta
  centroids <- clustered %>%
    filter(topic == topic_sel,
           questionid == questionid_sel,
           datavaluetypeid == datavaluetypeid_sel,
           !is.na(cluster)) %>%
    group_by(cluster) %>%
    summarise(centroid = mean(datavalue_num, na.rm = TRUE), .groups = "drop")

  # aggiunge i centroidi ai dati e crea etichette personalizzate per i facet
  df_plot <- df_plot %>%
    left_join(centroids, by = "cluster") %>%
    mutate(facet_lab = paste0("Cluster ", cluster, "\nμ=", round(centroid, 1)))

  # costruisce il grafico a torta per ciascun cluster
  ggplot(df_plot, aes(x = "", y = pct, fill = stratification1)) +
    geom_col(width = 1) +
    coord_polar(theta = "y") +
    geom_text(
      aes(label = label),
      position = position_stack(vjust = 0.5),
      size = 3,
      na.rm = TRUE
    ) +
    facet_wrap(~ facet_lab, ncol = 7) +
    labs(
      title = paste0(
        "distribuzione % race/ethnicity (k=7)\n",
        topic_sel, " | qid: ", questionid_sel, " | typeid: ", datavaluetypeid_sel
      ),
      fill = "race/ethnicity"
    ) +
    theme_void() +
    theme(
      strip.text = element_text(size = 8),
      plot.title = element_text(hjust = 0.5, face = "bold", size = 12),
      legend.position = "right"
    )
}
# crea una tabella con le combinazioni uniche di topic, questionid e datavaluetypeid ordinate
combos <- cluster_strat_pct %>%
  dplyr::distinct(topic, questionid, datavaluetypeid) %>%
  dplyr::arrange(topic, questionid, datavaluetypeid)

# ciclo per generare un grafico per ciascuna combinazione
for (i in seq_len(nrow(combos))) {
  # estrae i valori della combinazione corrente
  tp  <- combos$topic[i]
  qid <- combos$questionid[i]
  dvt <- combos$datavaluetypeid[i]
  
  # genera il grafico a torta per la combinazione corrente
  p <- plot_pies_for_combo(tp, qid, dvt)
  # stampa il grafico
  print(p)
}

LS0tDQp0aXRsZTogIkNsdXN0ZXIgRGVtb2dyYWZpY2kiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIEFuYWxpc2kgY2x1c3RlciBkZW1vZ3JhZmljaSBjb24gYWxnb3JpdG1vIG5vbiBzdXBlcnZpc2lvbmF0byAoay1tZWFuKQ0KDQoqKlJROioqICpBIHBhcnRpcmUgZGFsbGEgc3RyYXRpZmljYXppb25lIGRlbCBkYXRhc2V0IHBlciBjYXRlZ29yaWUgZGVtb2dyYWZpY2hlLCDDqCBwb3NzaWJpbGUgaW5kaXZpZHVhcmUgY2x1c3RlciBpbiByZWxhemlvbmUgYWkgZmVub21lbmkgb3NzZXJ2YXRpPyoNCg0KIyBGaWx0cm8gdG9waWM6IERpYWJldGVzICYgQ2FyZGlvdmFzY3VsYXIgRGlzZWFzZQ0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQoNCmRhdGFzZXRfcGF0aCA8LSAidV9zX2Nocm9uaWNfZGlzZWFzZV9pbmRpY2F0b3JzX2NkaS5jc3YiDQoNCmRmIDwtIHJlYWQuY3N2KGRhdGFzZXRfcGF0aCwgbmEuc3RyaW5ncyA9IGMoIiIsICJOQSIsICJOVUxMIiwgIm51bGwiKSkNCg0KZGZfZmlsdGVyZWQgPC0gZGYgJT4lDQogIGZpbHRlcih0b3BpYyAlaW4lIGMoIkRpYWJldGVzIiwgIkNhcmRpb3Zhc2N1bGFyIERpc2Vhc2UiKSkNCg0KYGBgDQoNCiMjIyBDb250ZWdnaW8gY2F0ZWdvcmllIGRlbW9ncmFmaWNoZSB1bml2b2NoZQ0KDQpgYGB7cn0NCmRmX2ZpbHRlcmVkICU+JQ0KICBmaWx0ZXIoc3RyYXRpZmljYXRpb25jYXRlZ29yeTEgPT0gIlJhY2UvRXRobmljaXR5IikgJT4lDQogIGNvdW50KHN0cmF0aWZpY2F0aW9uMSkgJT4lDQogIGFycmFuZ2UoZGVzYyhuKSkNCg0KYGBgDQoNCiMjIyBWaXN1YWxpenphemlvbmUgcXVlc3Rpb24gdW5pdm9jaGUNCg0KYGBge3J9DQpsaWJyYXJ5KGRwbHlyKQ0KDQpxaWRfbWFwIDwtIGRmX2ZpbHRlcmVkICU+JQ0KICBkaXN0aW5jdChxdWVzdGlvbmlkLCBxdWVzdGlvbikgJT4lDQogIGFycmFuZ2UocXVlc3Rpb25pZCkNCg0KIyBNb3N0cmEgbGEgdGFiZWxsYQ0Ka25pdHI6OmthYmxlKHFpZF9tYXAsIGNvbC5uYW1lcyA9IGMoIlF1ZXN0aW9uSUQiLCAiUXVlc3Rpb24iKSkNCg0KYGBgDQoNCiMgUHJlcGFyYXppb25lIGRhdGF2YWx1ZSBwZXIgSy1NZWFucw0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQoNCiMgY29udmVyc2lvbmUgaW4gbnVtZXJpY28gZGkgZGF0YXZhbHVlIChkYSBldmVudHVhbGUgc3RyaW5nYSkgZSBnZXN0aW9uZSB2aXJnb2xlIChkYSAsIGEgLikNCmRmX2sgPC0gZGZfZmlsdGVyZWQgJT4lDQogIG11dGF0ZSgNCiAgICBkYXRhdmFsdWVfbnVtID0gc3VwcHJlc3NXYXJuaW5ncyhhcy5udW1lcmljKGdzdWIoIiwiLCAiLiIsIGRhdGF2YWx1ZSwgZml4ZWQgPSBUUlVFKSkpLA0KICAgIC5yb3cgPSBkcGx5cjo6cm93X251bWJlcigpDQogICkNCg0KYGBgDQoNCiMgSy1NZWFucyAoayA9IDcpIHBlciBjaWFzY3VuYSBjb21iaW5hemlvbmUgKHRvcGljLCBxdWVzdGlvbmlkLCBkYXRhdmFsdWV0eXBlaWQpDQoNCmBgYHtyfQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkocHVycnIpDQoNCnNldC5zZWVkKDkpDQoNCiMgZXNlZ3VlIGlsIGNsdXN0ZXJpbmcgcGVyIG9nbmkgY29tYmluYXppb25lIGRpIHRvcGljLCBxdWVzdGlvbmlkIGUgZGF0YXZhbHVldHlwZWlkDQpjbHVzdGVyZWQgPC0gZGZfayAlPiUNCiAgIyByYWdncnVwcGEgaSBkYXRpDQogIGdyb3VwX2J5KHRvcGljLCBxdWVzdGlvbmlkLCBkYXRhdmFsdWV0eXBlaWQpICU+JQ0KICAjIGFwcGxpY2EgdW5hIGZ1bnppb25lIHBlcnNvbmFsaXp6YXRhIGEgY2lhc2N1biBncnVwcG8NCiAgZ3JvdXBfbW9kaWZ5KH57DQogICAgIyBwcmVuZGUgaWwgc290dG9pbnNpZW1lIGRpIGRhdGkgcmVsYXRpdm8gYWwgZ3J1cHBvDQogICAgZCA8LSAueA0KICAgICMgcmltdW92ZSBsZSByaWdoZSBjb24gdmFsb3JpIG1hbmNhbnRpIGluIGRhdGF2YWx1ZV9udW0NCiAgICBkX25vbl9uYSA8LSBkICU+JSBmaWx0ZXIoIWlzLm5hKGRhdGF2YWx1ZV9udW0pKQ0KDQogICAgIyBzZSBpbCBncnVwcG8gaGEgbWVubyBkaSA3IHJpZ2hlIG5vbiBwdcOyIGVzc2VyZSBkaXZpc28gaW4gNyBjbHVzdGVyDQogICAgaWYgKG5yb3coZF9ub25fbmEpIDwgNykgew0KICAgICAgIyBhc3NlZ25hIHZhbG9yaSBtYW5jYW50aSBhbGxhIGNvbG9ubmEgY2x1c3Rlcg0KICAgICAgZCRjbHVzdGVyIDwtIE5BX2ludGVnZXJfDQogICAgICAjIHJlc3RpdHVpc2NlIGlsIGdydXBwbyBjb3PDrCBjb23igJnDqA0KICAgICAgZA0KICAgIH0gZWxzZSB7DQogICAgICAjIGVzZWd1ZSBrbWVhbnMgY29uIDcgY2x1c3RlciBlIDI1IGluaXppYWxpenphemlvbmkNCiAgICAgIGttIDwtIGttZWFucyhkX25vbl9uYSRkYXRhdmFsdWVfbnVtLCBjZW50ZXJzID0gNywgbnN0YXJ0ID0gMjUpDQogICAgICAjIGFzc2VnbmEgbOKAmWV0aWNoZXR0YSBkaSBjbHVzdGVyIGFpIGRhdGkgc2VuemEgdmFsb3JpIG1hbmNhbnRpDQogICAgICBkX25vbl9uYSRjbHVzdGVyIDwtIGttJGNsdXN0ZXINCg0KICAgICAgIyB1bmlzY2UgaSBjbHVzdGVyIGNhbGNvbGF0aSBhaSBkYXRpIG9yaWdpbmFsaSB1c2FuZG8gbOKAmWluZGljZSBkaSByaWdhDQogICAgICBkICU+JSBsZWZ0X2pvaW4oZF9ub25fbmEgJT4lIHNlbGVjdCgucm93LCBjbHVzdGVyKSwgYnkgPSAiLnJvdyIpDQogICAgfQ0KICB9KSAlPiUNCiAgIyByaW11b3ZlIGxhIHN0cnV0dHVyYSBkaSByYWdncnVwcGFtZW50byBkYWwgcmlzdWx0YXRvIGZpbmFsZQ0KICB1bmdyb3VwKCkNCg0KIyBhbnRlcHJpbWEgZGVpIHJpc3VsdGF0aSBjb24gbGUgY29sb25uZSBwcmluY2lwYWxpDQpjbHVzdGVyZWQgJT4lDQogIHNlbGVjdCh0b3BpYywgcXVlc3Rpb25pZCwgZGF0YXZhbHVldHlwZWlkLCBkYXRhdmFsdWVfbnVtLCBjbHVzdGVyKSAlPiUNCiAgaGVhZCgpDQoNCmBgYA0KDQojIFBlcmNlbnR1YWxpIHBlciBzdHJhdGlmaWNhdGlvbiAoc29sbyBSYWNlL0V0aG5pY2l0eSkgZGVudHJvIGNpYXNjdW4gY2x1c3Rlcg0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KHRpZHlyKQ0KDQojIGNhbGNvbG8gZGVsbGUgcGVyY2VudHVhbGkgcGVyIG9nbmkgY2x1c3RlciBlIHN0cmF0aWZpY2F0aW9uDQpjbHVzdGVyX3N0cmF0X3BjdCA8LSBjbHVzdGVyZWQgJT4lDQogICMgZmlsdHJhIHNvbG8gaSByZWNvcmQgY29uIGNhdGVnb3JpYSByYWNlL2V0aG5pY2l0eSBlZCBlc2NsdWRlIGNsdXN0ZXIgbWFuY2FudGkNCiAgZmlsdGVyKHN0cmF0aWZpY2F0aW9uY2F0ZWdvcnkxID09ICJSYWNlL0V0aG5pY2l0eSIsICFpcy5uYShjbHVzdGVyKSkgJT4lDQogICMgcmFnZ3J1cHBhIHBlciB0b3BpYywgcXVlc3Rpb25pZCwgZGF0YXZhbHVldHlwZWlkIGUgY2x1c3Rlcg0KICBncm91cF9ieSh0b3BpYywgcXVlc3Rpb25pZCwgZGF0YXZhbHVldHlwZWlkLCBjbHVzdGVyKSAlPiUNCiAgIyBjYWxjb2xhIGxhIGRpbWVuc2lvbmUgdG90YWxlIGRlbCBjbHVzdGVyDQogIG11dGF0ZShjbHVzdGVyX3RvdGFsID0gbigpKSAlPiUNCiAgIyByYWdncnVwcGEgdWx0ZXJpb3JtZW50ZSBwZXIgc3RyYXRpZmljYXRpb24xDQogIGdyb3VwX2J5KHRvcGljLCBxdWVzdGlvbmlkLCBkYXRhdmFsdWV0eXBlaWQsIGNsdXN0ZXIsIHN0cmF0aWZpY2F0aW9uMSkgJT4lDQogICMgY2FsY29sYSBpbCBudW1lcm8gZGkgZWxlbWVudGkgcGVyIG9nbmkgY29tYmluYXppb25lDQogIHN1bW1hcmlzZSgNCiAgICBuID0gbigpLA0KICAgIGNsdXN0ZXJfdG90YWwgPSBkcGx5cjo6Zmlyc3QoY2x1c3Rlcl90b3RhbCksDQogICAgLmdyb3VwcyA9ICJkcm9wX2xhc3QiDQogICkgJT4lDQogICMgY2FsY29sYSBsYSBwZXJjZW50dWFsZSBkaSBjaWFzY3VuYSBjYXRlZ29yaWEgc3VsIHRvdGFsZSBkZWwgY2x1c3Rlcg0KICBtdXRhdGUocGN0ID0gMTAwICogbiAvIGNsdXN0ZXJfdG90YWwpICU+JQ0KICAjIHJpbXVvdmUgaSByYWdncnVwcGFtZW50aQ0KICB1bmdyb3VwKCkgJT4lDQogICMgb3JkaW5hIGkgcmlzdWx0YXRpDQogIGFycmFuZ2UodG9waWMsIHF1ZXN0aW9uaWQsIGRhdGF2YWx1ZXR5cGVpZCwgY2x1c3RlciwgZGVzYyhwY3QpKQ0KDQojIGFudGVwcmltYSBkZWxsZSBwcmltZSAyMCByaWdoZSBkZWxsYSB0YWJlbGxhIGZpbmFsZQ0KY2x1c3Rlcl9zdHJhdF9wY3QgJT4lIGhlYWQoMjApDQoNCmBgYA0KDQojIEdyYWZpY28gZOKAmWVzZW1waW8gc3VsbGEgY29tYmluYXppb25lIHBpw7kgcmFwcHJlc2VudGF0YQ0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KHRpZHlyKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQojIGRlZmluaXNjZSB1bmEgZnVuemlvbmUgY2hlIGdlbmVyYSA3IGdyYWZpY2kgYSB0b3J0YSBwZXIgdW5hIGNvbWJpbmF6aW9uZSBkaSB0b3BpYywgcXVlc3Rpb25pZCBlIGRhdGF2YWx1ZXR5cGVpZA0KcGxvdF9waWVzX2Zvcl9jb21ibyA8LSBmdW5jdGlvbih0b3BpY19zZWwsIHF1ZXN0aW9uaWRfc2VsLCBkYXRhdmFsdWV0eXBlaWRfc2VsKSB7DQogICMgZmlsdHJhIGkgZGF0aSBwZXIgbGEgY29tYmluYXppb25lIHNjZWx0YSBlIGNvbXBsZXRhIGkgY2x1c3RlciBtYW5jYW50aQ0KICBkZl9wbG90IDwtIGNsdXN0ZXJfc3RyYXRfcGN0ICU+JQ0KICAgIGZpbHRlcigNCiAgICAgIHRvcGljID09IHRvcGljX3NlbCwNCiAgICAgIHF1ZXN0aW9uaWQgPT0gcXVlc3Rpb25pZF9zZWwsDQogICAgICBkYXRhdmFsdWV0eXBlaWQgPT0gZGF0YXZhbHVldHlwZWlkX3NlbA0KICAgICkgJT4lDQogICAgY29tcGxldGUoDQogICAgICBjbHVzdGVyID0gMTo3LA0KICAgICAgc3RyYXRpZmljYXRpb24xLA0KICAgICAgZmlsbCA9IGxpc3QobiA9IDAsIGNsdXN0ZXJfdG90YWwgPSAwLCBwY3QgPSAwKQ0KICAgICkgJT4lDQogICAgbXV0YXRlKGxhYmVsID0gaWZlbHNlKHBjdCA+IDAsIHBhc3RlMChyb3VuZChwY3QsIDEpLCAiJSIpLCBOQSkpDQoNCiAgIyBjYWxjb2xhIGkgY2VudHJvaWRpIGRlaSBjbHVzdGVyIHBlciBsYSBjb21iaW5hemlvbmUgc2NlbHRhDQogIGNlbnRyb2lkcyA8LSBjbHVzdGVyZWQgJT4lDQogICAgZmlsdGVyKHRvcGljID09IHRvcGljX3NlbCwNCiAgICAgICAgICAgcXVlc3Rpb25pZCA9PSBxdWVzdGlvbmlkX3NlbCwNCiAgICAgICAgICAgZGF0YXZhbHVldHlwZWlkID09IGRhdGF2YWx1ZXR5cGVpZF9zZWwsDQogICAgICAgICAgICFpcy5uYShjbHVzdGVyKSkgJT4lDQogICAgZ3JvdXBfYnkoY2x1c3RlcikgJT4lDQogICAgc3VtbWFyaXNlKGNlbnRyb2lkID0gbWVhbihkYXRhdmFsdWVfbnVtLCBuYS5ybSA9IFRSVUUpLCAuZ3JvdXBzID0gImRyb3AiKQ0KDQogICMgYWdnaXVuZ2UgaSBjZW50cm9pZGkgYWkgZGF0aSBlIGNyZWEgZXRpY2hldHRlIHBlcnNvbmFsaXp6YXRlIHBlciBpIGZhY2V0DQogIGRmX3Bsb3QgPC0gZGZfcGxvdCAlPiUNCiAgICBsZWZ0X2pvaW4oY2VudHJvaWRzLCBieSA9ICJjbHVzdGVyIikgJT4lDQogICAgbXV0YXRlKGZhY2V0X2xhYiA9IHBhc3RlMCgiQ2x1c3RlciAiLCBjbHVzdGVyLCAiXG7OvD0iLCByb3VuZChjZW50cm9pZCwgMSkpKQ0KDQogICMgY29zdHJ1aXNjZSBpbCBncmFmaWNvIGEgdG9ydGEgcGVyIGNpYXNjdW4gY2x1c3Rlcg0KICBnZ3Bsb3QoZGZfcGxvdCwgYWVzKHggPSAiIiwgeSA9IHBjdCwgZmlsbCA9IHN0cmF0aWZpY2F0aW9uMSkpICsNCiAgICBnZW9tX2NvbCh3aWR0aCA9IDEpICsNCiAgICBjb29yZF9wb2xhcih0aGV0YSA9ICJ5IikgKw0KICAgIGdlb21fdGV4dCgNCiAgICAgIGFlcyhsYWJlbCA9IGxhYmVsKSwNCiAgICAgIHBvc2l0aW9uID0gcG9zaXRpb25fc3RhY2sodmp1c3QgPSAwLjUpLA0KICAgICAgc2l6ZSA9IDMsDQogICAgICBuYS5ybSA9IFRSVUUNCiAgICApICsNCiAgICBmYWNldF93cmFwKH4gZmFjZXRfbGFiLCBuY29sID0gNykgKw0KICAgIGxhYnMoDQogICAgICB0aXRsZSA9IHBhc3RlMCgNCiAgICAgICAgImRpc3RyaWJ1emlvbmUgJSByYWNlL2V0aG5pY2l0eSAoaz03KVxuIiwNCiAgICAgICAgdG9waWNfc2VsLCAiIHwgcWlkOiAiLCBxdWVzdGlvbmlkX3NlbCwgIiB8IHR5cGVpZDogIiwgZGF0YXZhbHVldHlwZWlkX3NlbA0KICAgICAgKSwNCiAgICAgIGZpbGwgPSAicmFjZS9ldGhuaWNpdHkiDQogICAgKSArDQogICAgdGhlbWVfdm9pZCgpICsNCiAgICB0aGVtZSgNCiAgICAgIHN0cmlwLnRleHQgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDgpLA0KICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSwgZmFjZSA9ICJib2xkIiwgc2l6ZSA9IDEyKSwNCiAgICAgIGxlZ2VuZC5wb3NpdGlvbiA9ICJyaWdodCINCiAgICApDQp9DQpgYGANCg0KYGBge3J9DQojIGNyZWEgdW5hIHRhYmVsbGEgY29uIGxlIGNvbWJpbmF6aW9uaSB1bmljaGUgZGkgdG9waWMsIHF1ZXN0aW9uaWQgZSBkYXRhdmFsdWV0eXBlaWQgb3JkaW5hdGUNCmNvbWJvcyA8LSBjbHVzdGVyX3N0cmF0X3BjdCAlPiUNCiAgZHBseXI6OmRpc3RpbmN0KHRvcGljLCBxdWVzdGlvbmlkLCBkYXRhdmFsdWV0eXBlaWQpICU+JQ0KICBkcGx5cjo6YXJyYW5nZSh0b3BpYywgcXVlc3Rpb25pZCwgZGF0YXZhbHVldHlwZWlkKQ0KDQojIGNpY2xvIHBlciBnZW5lcmFyZSB1biBncmFmaWNvIHBlciBjaWFzY3VuYSBjb21iaW5hemlvbmUNCmZvciAoaSBpbiBzZXFfbGVuKG5yb3coY29tYm9zKSkpIHsNCiAgIyBlc3RyYWUgaSB2YWxvcmkgZGVsbGEgY29tYmluYXppb25lIGNvcnJlbnRlDQogIHRwICA8LSBjb21ib3MkdG9waWNbaV0NCiAgcWlkIDwtIGNvbWJvcyRxdWVzdGlvbmlkW2ldDQogIGR2dCA8LSBjb21ib3MkZGF0YXZhbHVldHlwZWlkW2ldDQogIA0KICAjIGdlbmVyYSBpbCBncmFmaWNvIGEgdG9ydGEgcGVyIGxhIGNvbWJpbmF6aW9uZSBjb3JyZW50ZQ0KICBwIDwtIHBsb3RfcGllc19mb3JfY29tYm8odHAsIHFpZCwgZHZ0KQ0KICAjIHN0YW1wYSBpbCBncmFmaWNvDQogIHByaW50KHApDQp9DQpgYGANCg==